perm filename PROGS.MAC[11,HE]1 blob
sn#617471 filedate 1981-10-07 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00014 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00003 00002 .TITLE File Transfer Program FTP.MAC
C00008 00003 Auxiliary routines to parse filenames: FPAR11 & FPAR10
C00015 00004 Some more auxiliary routines: SETF11, SETF10, FCOPY, SKIPB
C00019 00005 I/O auxiliary routines: GETLIN & OUTNUM
C00021 00006 Program initialization
C00024 00007 Command loop
C00027 00008 Store 10file ← 11file
C00031 00009 Get 11file ← 10file
C00035 00010 Set alias ppn for 10 & Exit
C00037 00011 .TITLE File Transfer Program 11FTP.MAC
C00053 00012 .TITLE IMAGE MODE FTP IFTP.MAC
C00060 00013 .TITLE DISK I/O TEST PROGRAM DISKB.MAC
C00068 00014 .TITLE DISK I/O TEST PROGRAM DISKI.MAC
C00077 ENDMK
C⊗;
.TITLE File Transfer Program ;FTP.MAC
.MCALL ALUN$S,GLUN$S,QIOW$S,EXIT$S,GREG$S,MRKT$S,WTSE$S
.MCALL FDBDF$,FDAT$A,FDRC$A,FDBK$A,FDOP$A,FINIT$,FSRSZ$
.MCALL OPEN$R,OPEN$W,CLOSE$,READ$,WRITE$
.MCALL WAIT$
;need mcall for pausing 1/60 sec or thereabouts
; MRKT$S #1,#1,#1 ;efn,tmg,tnt
; MRKT$S #1,#2,#1 ;Wait two ticks
; BCS 1$ ;If it isn't accepted don't bother waiting
; WTSE$S #1
; 1$:
;?? what if file exactly fits last block? what are values for F.EFBK & F.FFBY??
.BLKW 100 ;Make some stack space
SPSTRT:
REGBUF: .BLKW 3 ;To stick region info into
RDSTS: .WORD 0 ;Read status block
RDCNT: .WORD 0
TTYBUF: .BLKB 80. ;For reading commands
WRSTS: .WORD 0,0 ;Write status block
STATBF: .BYTE TC.SCP ;Ask if CRT
TALK11: .BYTE 0
ECHO: .BYTE TC.NEC ;Set /ECHO=TT10: or /NOECHO=TT10:
ECHOP: .BYTE 1
FLBUF: .BYTE TC.TBF,0 ;Also flush type-ahead buffer
SLAVE: .BYTE TC.SLV ;Set terminal = slave
SLAVEP: .BYTE 0
IOSTAT: .WORD 0,0 ;Status for disk ops
F1: .WORD 0,0 ;Pointer/length pairs
F2: .WORD 0,0
FNAM11: .WORD 0,0
FEXT11: .WORD 0,0
FVER11: .WORD 0,0
FNAM10: .WORD 0,0
FEXT10: .WORD 0,0
PPN10: .WORD 0,0
ALIAS: .WORD DEFPPN,7 ;Default ppn for 10
LUN10: .WORD 1 ;Logical unit number for tty link to 10
NUMBUF: .BLKB 12.
BUFPTR: .WORD 0
FILDON: .WORD 0 ;Contains first free byte address for last buffer
CMD: .WORD 0
FDB: FDBDF$ ;Make up the disk header info
; FDAT$A R.FIX,,512.,-120.
; FDRC$A FD.RWM
; FDBK$A BUFFER,512.,,2,IOSTAT
; FDOP$A 2,DATSET
FSRSZ$ 1
DBUF: .BLKW 256. ;Disk block buffer
DATSET:
DEVCNT: .WORD 0
DEVNAM: .WORD 0
UICCNT: .WORD 0
UICNAM: .WORD 0
FILCNT: .WORD 0
FILNAM: .WORD FILBUF
DEV: .ASCII / /
SYSDEV: .ASCII /SY:/
OKMES: .ASCII /OK/
OKSIZ = .-OKMES
BADDEV: .ASCII /NO SUCH DEVICE/
BDEVSZ = .-BADDEV
BADFIL: .ASCII /CAN'T OPEN FILE/
BFILSZ = .-BADFIL
HIMES: .ASCII <15><12>/10-11 FTP Program/<15><12><12>
.ASCII /G to get a file from the 10/<15><12>
.ASCII /S to store a file on the 10/<15><12>
.ASCII /A to set an alias on the 10 {default= [11,HE]}/<15><12>
.ASCII /X to exit/<15><12><12>
HISIZ = .-HIMES
LOGMES: .ASCII <15>/L 11.HE/<15>
LOGSIZ = .-LOGMES
RUNMES: .ASCII /R 11FTP/<15>
RUNSIZ = .-RUNMES
BYEMES: .ASCII /X /<15><15>/K/<15>
BYESIZ = .-BYEMES
DEFPPN: .ASCII /[11,HE] /
DEFVER: .ASCII /;0/
PROMPT: .ASCII <15><12>/*/
PRSIZ = .-PROMPT
CMDMES: .ASCII /S /
FILBUF: .BLKB 30.
ABTMES: .ASCII <12>/Aborted by 10 /
ABTSIZ = .-ABTMES
UNKMES: .ASCII /Unknown command/
UNKSIZ = .-UNKMES
.EVEN
;Auxiliary routines to parse filenames: FPAR11 & FPAR10
; called with R0 pointing to string to parse
FPAR11: MOV (R0)+,R1 ;R1 ← chars to parse
MOV (R0),R4 ;R4 ← char count
CLR DEVCNT ;Clear out old values
CLR UICCNT
CLR FNAM11+2
CLR FEXT11+2
MOV #DEFVER,FVER11 ;Set default version # to ";0"
MOV #2,FVER11+2
CMPB (R1),#"[ ;UIC?
BEQ UICPAR ;Go parse UIC, no device given
CMPB 1(R1),#": ;See if we have a device
BEQ DEVPAR
CMPB 2(R1),#":
BEQ DEVPAR
CMPB 3(R1),#":
BEQ DEVPAR
BR PFNM11 ;No device or UIC given - get filename
DEVPAR: MOV R1,DEVNAM ;Point data set at device name
MOVB (R1)+,DEV ;Store first char of device name
CLRB DEV+1 ;In case no second char
CLR R3 ;Unit # of device (default = 0)
1$: INC DEVCNT
CMPB (R1),#": ;Scan til ":"
BEQ 3$ ; Done
CMPB (R1),#"A ;Alpha?
BMI 2$ ; No - < "A"
MOVB (R1)+,DEV+1 ;Store second char of device name
BR 1$
2$: MOVB (R1)+,R3 ;Get Unit # in R3
SUB #60,R3 ;Convert ASCII to # (-"0")
BR 1$
3$: INC R1
INC DEVCNT
SUB DEVCNT,R4 ;Update char count
ALUN$S #2,DEV,R3 ;LUN 2 is device
BCC UICPAR
QIOW$S #IO.WLB,#1,#1,,#WRSTS,,<#BADDEV,#BDEVSZ,#40> ;Abort if bad dev
BCC 4$
IOT ;Punt if error
4$: SEC ;Indicate an error
RTS PC ; & Return
UICPAR: CMPB (R1),#"[ ;UIC?
BNE PFNM11 ;Go parse filename, no UIC given
MOV R1,UICNAM ;Point to start of UIC
1$: INC UICCNT
CMPB (R1)+,#"] ;Scan to closing "]"
BNE 1$
SUB UICCNT,R4 ;Update count of characters left
PFNM11: TST R4 ;Check more to parse
BEQ 6$ ; No - all done here (almost)
MOV R1,FNAM11 ;Point to start of filename
1$: CMPB (R1),#". ;Search til "."
BEQ 2$
CMPB (R1),#"; ; or ";"
BEQ 2$
INC R1 ;Point to next char
DEC R4 ;Update chars left
BGT 1$ ; & keep going if any left
2$: MOV R1,FNAM11+2
SUB FNAM11,FNAM11+2 ;Length of file name
CMPB (R1),#". ;Extension present
BNE 5$ ; No
MOV R1,FEXT11 ;Point to start of file extension
3$: CMPB (R1),#"; ;Search til ";"
BEQ 4$
INC R1 ;Point to next char
DEC R4 ;Update chars left
BGT 3$ ; & keep going if any left
4$: MOV R1,FEXT11+2
SUB FEXT11,FEXT11+2 ;Length of file extension
5$: CMPB (R1),#73 ;Version number present? (73=";")
BNE 6$ ; No
MOV R1,FVER11 ; Yes - point to start of version #
MOV R4,FVER11+2 ; & indicate it's length
6$: TST DEVCNT ;Was a device specified?
BNE 7$ ; Yes - all done
MOV #SYSDEV,DEVNAM ; No - use SY: as default
MOV #3,DEVCNT
ALUN$S #2,#"SY,#0 ;LUN 2 is SY:
7$: CLC ;Indicate success
RTS PC ;All done here
FPAR10: MOV (R0)+,R1 ;R1 ← chars to parse
MOV (R0),R4 ;R4 ← char count
CLR FNAM10+2 ;Zero old values
CLR FEXT10+2
MOV ALIAS,PPN10 ;Assume alias ppn
MOV ALIAS+2,PPN10+2
TST R4 ;Check if anything to parse
BEQ 8$ ; No - all done here
MOV R1,FNAM10 ;Point to start of filename
1$: CMPB (R1),#". ;Search til "."
BEQ 2$
CMPB (R1),#"[ ; or "["
BEQ 2$
INC R1 ;Point to next char
DEC R4 ;Update chars left
BGT 1$ ; & keep going if any left
2$: MOV R1,FNAM10+2
SUB FNAM10,FNAM10+2 ;Length of file name
CMPB (R1),#". ;Extension present
BNE 5$ ; No
MOV R1,FEXT10 ;Point to start of file extension
3$: CMPB (R1),#"[ ;Search til "["
BEQ 4$
INC R1 ;Point to next char
DEC R4 ;Update chars left
BGT 3$ ; & keep going if any left
4$: MOV R1,FEXT10+2
SUB FEXT10,FEXT10+2 ;Length of file extension
5$: CMPB (R1),#"[ ;PPN?
BNE 8$ ; No - all done
MOV R1,PPN10 ;Point to start of ppn
6$: DEC R4 ;Update char count
BMI 7$ ;Quit if no more chars
CMPB (R1)+,#"] ;Scan to closing "]"
BNE 6$
7$: MOV R1,PPN10+2
SUB PPN10,PPN10+2 ;Length of ppn
8$: RTS PC ;All done - return
;Some more auxiliary routines: SETF11, SETF10, FCOPY, SKIPB
SETF11: MOV #FILBUF,R2
MOV #30,R0
1$: CLRB (R2)+ ;Zero out old file name
SOB R0,1$
MOV #FILBUF,R2 ;Now build up new one
CLR R3
MOV #FNAM11,R0 ;Copy file name
JSR PC,FCOPY
MOV #FEXT11,R0 ;Copy file extension
JSR PC,FCOPY
MOV #FVER11,R0 ;Copy file version number
JSR PC,FCOPY
MOV R3,FILCNT ;Set filename char count
RTS PC
SETF10: MOV #FILBUF,R2
MOV #30,R0
1$: CLRB (R2)+ ;Zero out old file name
SOB R0,1$
MOV #FILBUF,R2 ;Now build up new one
CLR R3
MOV #FNAM10,R0 ;Copy file name
JSR PC,FCOPY
MOV #FEXT10,R0 ;Copy file extension
JSR PC,FCOPY
MOV #PPN10,R0 ;Copy ppn
JSR PC,FCOPY
MOVB #15,(R2)+ ;Append a cr
ADD #3,R3 ;Fix up char count to include command & cr
QIOW$S #IO.WLB,#3,#1,,#WRSTS,,<#CMDMES,R3,#0> ;Tell 10 file to rd/wrt
BCC 2$
IOT ;Punt if error
2$: MOV #3,R3
JSR PC,GETLIN ;Ignore echo
TST R4
BEQ 2$ ;Repeat if null line
3$: MOV #3,R3
JSR PC,GETLIN ;Get 10's reply
TST R4
BEQ 3$ ;Repeat if null line
CMPB (R1),#"O ;Is everything okay?
BNE 4$ ; No - complain
CMPB 1(R1),#"K
BEQ 5$ ; Yes - go do the transfer
4$: MOV R1,-(SP) ;Save error string
MOV R4,-(SP)
QIOW$S #IO.WLB,#1,#1,,#WRSTS,,<#ABTMES,#ABTSIZ,#0> ;Say we're aborting
MOV (SP)+,R4
MOV (SP)+,R1
QIOW$S #IO.WLB,#1,#1,,#WRSTS,,<R1,R4,#0> ; & tell why
SEC ;Indicate abort & return
RTS PC
5$: CLC ;Indicate all's well & return
RTS PC
FCOPY: MOV (R0)+,R1 ;R1 ← String to copy
MOV (R0),R4 ;R4 ← char count for string
BEQ 2$ ;If null string all done
ADD R4,R3 ;Update current string length
1$: MOVB (R1)+,(R2)+ ;Copy chars
SOB R4,1$
2$: RTS PC ;Done
SKIPB: CMPB (R1),#40 ;A blank?
BNE 1$ ; No - all done
INC R1
DEC R4 ;Update char count
BGT SKIPB ; & keep going if more
1$: RTS PC ;Done
;I/O auxiliary routines: GETLIN & OUTNUM
GETLIN: MOV #TTYBUF,R1
MOV #40,R0
1$: CLR (R1)+ ;Zero command line buffer
SOB R0,1$
QIOW$S #IO.RLB,R3,#1,,#RDSTS,,<#TTYBUF,#80.> ;Read in a line
BCC 2$
IOT ;Punt if error
2$: MOV #TTYBUF,R1
3$: CMPB (R1),#12 ;Skip over linefeeds
BNE 4$
INC R1
DEC RDCNT ;Update read count
BPL 3$
4$: RTS PC
;Auxiliary routine to print out the octal number in R1
OUTNUM: MOV R0,-(SP) ;We need some free registers
MOV R1,-(SP)
MOV R2,-(SP)
MOV R3,-(SP)
MOV #NUMBUF,R2 ;Where we'll stick the result
CLR R0
MOV #6,R3 ;6 digits to print
ASHC #1,R0 ;Get high order digit
1$: TST R0 ;Don't print leading zeros
BNE 2$ ;Found highest order non-zero digit
ASHC #3,R0 ;Try next
SOB R3,1$
INC R3
2$: ADD #60,R0 ;Convert to ASCII
MOVB R0,(R2)+ ;Stick it in buffer
CLR R0
ASHC #3,R0 ;Move on to next digit
SOB R3,2$ ;Do them all
SUB #NUMBUF,R2 ;Get character count for writing
QIOW$S #IO.WLB,LUN10,#1,,#WRSTS,,<#NUMBUF,R2,#40> ;Type it out to 10
BCC 3$
IOT ;Punt if error
3$: MOV (SP)+,R3 ;Restore registers
MOV (SP)+,R2
MOV (SP)+,R1
MOV (SP)+,R0
RTS PC
;Program initialization
START: MOV #SPSTRT,SP ;Set up stack???
ALUN$S #1,#"TI,#0 ;LUN 1 is TI: device
BCC 1$
IOT ;Punt if error
1$: QIOW$S #IO.ATT,#1,#1 ;Attach it
BCC 2$
IOT ;Punt if error
2$: QIOW$S #SF.GMC,#1,#1,,,,<#STATBF,#2> ;See if we're talking to 10 or 11
BCC 3$
IOT ;Punt if error
3$: TSTB TALK11 ;Are we talking to the 11?
BNE 4$ ; Yes
JMP WRTADR ; No - go tell 10 our memory addresses
4$: QIOW$S #IO.WLB,#1,#1,,#WRSTS,,<#HIMES,#HISIZ,#0> ;Say hello
BCC 5$
IOT ;Punt if error
5$: MOV #3,LUN10 ;Use logical unit number 3 to talk to 10
ALUN$S #3,#"TT,#10 ;LUN 3 is device TT10:
QIOW$S #IO.ATT,#3,#1 ;Attach it
BCC 6$
IOT ;Punt if error
6$: MOVB #1,ECHOP ;Turn off echoing
QIOW$S #SF.SMC,#3,#1,,,,<#ECHO,#2>
BCC 7$
IOT ;Punt if error
7$: MOVB #1,SLAVEP ;Enslave terminal
QIOW$S #SF.SMC,#3,#1,,,,<#SLAVE,#2>
BCC 8$
IOT ;Punt if error
8$: QIOW$S #IO.WLB,#3,#1,,#WRSTS,,<#LOGMES,#LOGSIZ,#0> ;Login on 10
BCC 9$
IOT ;Punt if error
9$: MOV #3,R3
JSR PC,GETLIN ;Get a line from 10
CMP R4,#2
BNE 9$
CMPB (R1)+,#"↑ ;Look for "↑C"
BNE 9$
CMPB (R1),#"C
BNE 9$
QIOW$S #IO.WLB,#3,#1,,#WRSTS,,<#RUNMES,#RUNSIZ,#0> ;Start 11FTP program
BCC 10$
IOT ;Punt if error
10$: MOV #3,R3
JSR PC,GETLIN ;Get echoed line from 10
WRTADR: GREG$S ,#REGBUF ;Get region base address
BCC 1$
IOT
1$: MOV REGBUF,R1
JSR PC,OUTNUM ;Print it out
MOV #BUFPTR,R1 ;Give local address of buffer pointer
JSR PC,OUTNUM ;Print it out
TSTB TALK11 ;See who's in charge
BEQ 2$ ;If 10 skip ahead
MOV #3,R3 ;If 11 read back the echoed lines
JSR PC,GETLIN ; mapping offset for region base
JSR PC,GETLIN ; & buffer pointer
2$: ALUN$S #2,#"SY,#0 ;LUN 2 is SY: by default
FINIT$
BCC CLOOP
IOT
;Command loop
CLOOP: CLR BUFPTR
CLR FILDON
CLR DEVCNT ;Re-initialize Data set descriptor
CLR UICCNT
CLR FILCNT
TSTB TALK11 ;Talking to 11?
BEQ 1$ ; No
QIOW$S #IO.WLB,#1,#1,,#WRSTS,,<#PROMPT,#PRSIZ,#0> ;Type out prompt
1$: MOV #1,R3 ;Get a command line from TI:
JSR PC,GETLIN
CMPB (R1),#"E ;All done? Command = "E"
BNE 2$ ; No - go execute command
TSTB TALK11 ;Did it come from the 10?
BNE 2$ ; No - ignore it
EXIT$S ERROR ; Yes - Go away
2$: MOV RDCNT,R4 ;See how many characters were typed
BEQ 1$ ;Ignore null lines
MOVB (R1)+,CMD ;Save command
DEC R4 ;Update char count
JSR PC,SKIPB ;Skip over blanks
MOV R1,F1 ;f1 ← first part of string
3$: CMPB (R1)+,#"= ;find "=" if present
BEQ 4$
DEC R4 ;Update char count
BGT 3$ ; & Keep looking
4$: MOV R1,F1+2
SUB F1,F1+2 ;Compute length of file spec
INC R1 ;Skip past "←"
DEC R4 ;Update char count
JSR PC,SKIPB ;Skip over blanks
MOV R1,F2 ;f2 ← rest of string
MOV R4,F2+2
CMDDIS: BIC #40,CMD ;Make command upper case
CMPB CMD,#"S ;See what we're supposed to do
BNE 1$
JMP RDFILE ;"S" - Go read in an old file
1$: CMPB CMD,#"G
BNE 2$
JMP WTFILE ;"G" - Go write out a new file
2$: CMPB CMD,#"A
BNE 3$
JMP SETPPN ;"A" - Set alias ppn for 10
3$: CMPB CMD,#"X
BNE 4$
JMP DONE ;"X" - Time to go away
4$: QIOW$S #IO.WLB,#1,#1,,#WRSTS,,<#UNKMES,#UNKSIZ,#40> ;Bad command
JMP CLOOP
;Store 10file ← 11file
RDFILE: TSTB TALK11 ;See who we're talking to
BEQ 5$ ;If 10 skip ahead
MOV #F1,R0
JSR PC,FPAR10 ;PARSE10(f1)
MOV #F2,R0
JSR PC,FPAR11 ;PARSE11(f2)
BCC 1$ ;Check for bad device
JMP CLOOP ; Yup - punt
1$: TST FNAM10+2 ;Is fnam10 = null?
BNE 2$ ; No
MOV FNAM11,FNAM10 ; Yes: fnam10 ← fnam11
MOV FNAM11+2,FNAM10+2
2$: TST FEXT10+2 ;Is fext10 = null?
BNE 3$ ; No
MOV FEXT11,FEXT10 ; Yes: fext10 ← fext11
MOV FEXT11+2,FEXT10+2
3$: TST FNAM11+2 ;Is fnam11 = null?
BNE 4$ ; No
MOV FNAM10,FNAM11 ; Yes: fnam11 ← fnam10
MOV FNAM10+2,FNAM11+2
4$: TST FEXT11+2 ;Is fext11 = null?
BNE 6$ ; No
MOV FEXT10,FEXT11 ; Yes: fext11 ← fext10
MOV FEXT10+2,FEXT11+2
BR 6$
5$: MOV #F1,R0
JSR PC,FPAR11 ;PARSE11(f1)
BCC 6$ ;Check for bad device
JMP CLOOP ; Yup - punt
6$: JSR PC,SETF11 ;Copy file name so it's one string
OPEN$R #FDB,#2,#DATSET,#FD.RWM,#DBUF,#512.,FILERR ;Try to open it
TSTB TALK11 ;Talking to 11?
BEQ 10$ ; No
MOVB #"G ,CMDMES
JSR PC,SETF10 ;Tell 10 name of file to create
BCC 11$ ;Go do the transfer if 10 said OK
JMP CLOOP ;Else punt
10$: QIOW$S #IO.WLB,#1,#1,,#WRSTS,,<#OKMES,#OKSIZ,#40> ;Tell 10 all's well
BCC 11$
IOT ;Punt if error
11$: MOV FDB+F.EFBK+2,R4 ;R4 has count of blocks in file
RLOOP: READ$ #FDB,,,,,,,RWERR ;Read in next block
WAIT$ #FDB,,,RWERR
TSTB IOSTAT ;Did it succeed?
BPL 1$ ; Yes
JMP RWERR ; No - punt
1$: DEC R4 ;One less block to read
BGT 2$ ;Was this the last block?
MOV F.FFBY(R0),FILDON ; Yes - tell 10 this is the end
2$: MOV #DBUF,BUFPTR ;Give buffer to 10
3$: MRKT$S #1,#2,#1 ;Wait two ticks
BCS 4$ ;Make sure we got scheduled
WTSE$S #1
4$: TST BUFPTR ;Has 10 finished with it yet?
BNE 3$ ; No - keep waiting
TST R4 ;More to send?
BGT RLOOP ; Yup - go read next block
JMP FDONE ; No - go close file & get next command
;Get 11file ← 10file
WTFILE: MOV #F1,R0
JSR PC,FPAR11 ;PARSE11(f1)
BCC 1$ ;Check for bad device
JMP CLOOP ; Yup - punt
1$: MOV #F2,R0
JSR PC,FPAR10 ;PARSE10(f2)
TST FNAM11+2 ;Is fnam11 = null?
BNE 2$ ; No
MOV FNAM10,FNAM11 ; Yes: fnam11 ← fnam10
MOV FNAM10+2,FNAM11+2
2$: TST FEXT11+2 ;Is fext11 = null?
BNE 3$ ; No
MOV FEXT10,FEXT11 ; Yes: fext11 ← fext10
MOV FEXT10+2,FEXT11+2
3$: TST FNAM10+2 ;Is fnam10 = null?
BNE 4$ ; No
MOV FNAM11,FNAM10 ; Yes: fnam10 ← fnam11
MOV FNAM11+2,FNAM10+2
4$: TST FEXT10+2 ;Is fext10 = null?
BNE 5$ ; No
MOV FEXT11,FEXT10 ; Yes: fext10 ← fext11
MOV FEXT11+2,FEXT10+2
5$: JSR PC,SETF11 ;Copy file name so it's one string
OPEN$W #FDB,#2,#DATSET,#FD.RWM,#DBUF,#512.,FILERR ;Try to enter it
TSTB TALK11 ;Talking to 11?
BEQ 10$ ; No
MOVB #"S ,CMDMES
JSR PC,SETF10 ;Tell 10 name of file to read
BCC 11$ ;Go do the transfer if 10 said OK
JMP CLOOP ;Else punt
10$: QIOW$S #IO.WLB,#1,#1,,#WRSTS,,<#OKMES,#OKSIZ,#40> ;Tell 10 all's well
BCC 11$
IOT ;Punt if error
11$: CLR R4 ;Keep a count of # of blocks we write
WLOOP: MOV #DBUF,BUFPTR ;Tell 10 where to stick block
1$: MRKT$S #1,#2,#1 ;Wait two ticks
BCS 2$ ;Make sure we got scheduled
WTSE$S #1
2$: TST BUFPTR ;Has 10 finished with it yet?
BNE 1$ ; No - keep waiting
WRITE$ #FDB,,,,,,,RWERR ;Write out next block
WAIT$ #FDB,,,RWERR
TSTB IOSTAT ;Did it succeed?
BMI RWERR ; No - punt
INC R4 ;Update block count
TST FILDON ;Was this last block?
BEQ WLOOP ; No - get next block
; Yes - fix up FDB
MOVB #2,F.RTYP+FDB ;Say we're really a variable length file
MOVB #2,F.RATT+FDB ;Say to print a cr after each record
MOV #130.,F.RSIZ+FDB ;Biggest record should be less than this
MOV R4,F.EFBK+2+FDB ;Tell how many blocks we are
MOV FILDON,F.FFBY+FDB ;Tell where the last record ends
;Now we can close the file
FDONE: CLOSE$ #FDB,ERROR ;All done with file now
CLR BUFPTR
JMP CLOOP ;Get next command
FILERR: QIOW$S #IO.WLB,#1,#1,,#WRSTS,,<#BADFIL,#BFILSZ,#40> ;Abort if bad file
BCC 1$
IOT ;Punt if error
1$: JMP CLOOP ;Try again
RWERR: MOV #1,BUFPTR ;Abort if read/write error
JMP CLOOP ;Try again
ERROR: IOT ;Punt if error
;Set alias ppn for 10 & Exit
SETPPN: MOV #F1,R0
JSR PC,FPAR10 ;Go parse ppn
MOV PPN10,R1 ;Get string to copy
MOV PPN10+2,R4 ; & its length
MOV #DEFPPN,R2 ;Where to copy it to
MOV R4,ALIAS+2 ;Update ppn length
1$: MOVB (R1)+,(R2)+ ;Copy chars
SOB R4,1$
JMP CLOOP ;Done
DONE: TSTB TALK11 ;Are we in charge?
BEQ 5$ ; No - just go away
QIOW$S #IO.WLB,#3,#1,,#WRSTS,,<#BYEMES,#BYESIZ,#0> ;Tell 10 goodbye
BCC 1$
IOT ;Punt if error
1$: ;flush buffer?
2$: CLRB ECHOP ;Turn echoing back on
CLRB SLAVEP ;Become a free terminal again
QIOW$S #SF.SMC,#3,#1,,,,<#ECHO,#6>
BCC 5$
IOT ;Punt if error
5$: EXIT$S ERROR ;Go away
.END START
.TITLE File Transfer Program ;11FTP.MAC
.MCALL ALUN$S,GLUN$S,QIOW$S,EXIT$S,GREG$S
.MCALL FDBDF$,FDAT$A,FDRC$A,FDBK$A,FDOP$A,FINIT$,FSRSZ$
.MCALL OPEN$R,OPEN$W,CLOSE$,READ$,WRITE$
.MCALL WAIT$
;need mcall for pausing 1/60 sec or thereabouts
;?? what if file exactly fits last block? what are values for F.EFBK & F.FFBY??
.BLKW 100 ;Make some stack space
SPSTRT:
REGBUF: .BLKW 3 ;To stick region info into
RDSTS: .WORD 0 ;Read status block
RDCNT: .WORD 0
TTYBUF: .BLKB 80. ;For reading commands
WRSTS: .WORD 0,0 ;Write status block
STATBF: .BYTE TC.SCP ;Ask if CRT
CRTP: .BYTE 0
IOSTAT: .WORD 0,0 ;Status for disk ops
NUMBUF: .BLKB 12.
BUFPTR: .WORD 0
FILDON: .WORD 0 ;Contains first free byte address for last buffer
COM: .WORD 0
FDB: FDBDF$ ;Make up the disk header info
; FDAT$A R.FIX,,512.,-120.
; FDRC$A FD.RWM
; FDBK$A BUFFER,512.,,2,IOSTAT
; FDOP$A 2,DATSET
FSRSZ$ 1
DBUF: .BLKW 256. ;Disk block buffer
DATSET:
DEVCNT: .WORD 0
DEVNAM: .WORD 0
UICCNT: .WORD 0
UICNAM: .WORD 0
FILCNT: .WORD 0
FILNAM: .WORD 0
DEV: .ASCII / /
OKMES: .ASCII /OK/
OKSIZ = .-OKMES
BADDEV: .ASCII /NO SUCH DEVICE/
BDEVSZ = .-BADDEV
BADFIL: .ASCII /CAN'T OPEN FILE/
BFILSZ = .-BADFIL
.EVEN
START: MOV #SPSTRT,SP ;Set up stack???
ALUN$S #1,#"TI,#0 ;LUN 1 is TI: device
BCC 1$
IOT ;Punt if error
1$: QIOW$S #IO.ATT,#1,#1 ;Attach it
BCC 2$
IOT ;Punt if error
2$: GREG$S ,#REGBUF ;Get region base address
BCC 3$
IOT
3$: MOV REGBUF,R1
JSR PC,OUTNUM ;Print it out
MOV #BUFPTR,R1 ;Give local address of buffer pointer
JSR PC,OUTNUM ;Print it out
FINIT$
BCC CLOOP
IOT
CLOOP: CLR BUFPTR
CLR FILDON
CLR DEVCNT ;Re-initialize Data set descriptor
CLR UICCNT
CLR FILCNT
MOV #TTYBUF,R1
MOV #40,R0
1$: CLR (R1)+ ;Zero command line buffer
SOB R0,1$
2$: QIOW$S #IO.RLB,#1,#1,,#RDSTS,,<#TTYBUF,#80.> ;Get a command line
BCC 3$
IOT ;Punt if error
3$: MOV #TTYBUF,R1
4$: CMPB (R1),#12 ;Skip over linefeeds
BNE 5$
INC R1
DEC RDCNT ;Update read count
BPL 4$
CLR RDCNT
5$: CMPB (R1),#105 ;All done? Command = "E"
BNE 6$ ; No - go execute command
EXIT$S ERROR ; Yes - Go away
6$: MOV RDCNT,R4 ;See how many characters were typed
BEQ 2$ ;Ignore null lines
SUB #2,R4 ;Don't care about command
MOVB (R1)+,COM ;Save command
INC R1 ;Point to start of file spec
CMPB (R1),#133 ;UIC?
BEQ UICPAR ;Go parse UIC, no device given
CMPB 1(R1),#72 ;See if we have a device
BEQ DEVPAR
CMPB 2(R1),#72
BEQ DEVPAR
CMPB 3(R1),#72
BEQ DEVPAR
BR FILPAR ;No device or UIC given - get filename
DEVPAR: MOV R1,DEVNAM ;Point data set at device name
MOVB (R1)+,DEV ;Store first char of device name
CLRB DEV+1 ;In case no second char
CLR R3 ;Unit # of device (default = 0)
1$: INC DEVCNT
CMPB (R1),#72 ;Scan til ":"
BEQ 3$ ; Done
CMPB (R1),#101 ;Alpha?
BMI 2$ ; No - < "A"
MOVB (R1)+,DEV+1 ;Store second char of device name
BR 1$
2$: MOVB (R1)+,R3 ;Get Unit # in R3
SUB #60,R3 ;Convert ASCII to # (-"0")
BR 1$
3$: INC R1
INC DEVCNT
SUB DEVCNT,R4 ;Update char count
ALUN$S #2,DEV,R3 ;LUN 2 is device
BCC UICPAR
QIOW$S #IO.WLB,#1,#1,,#WRSTS,,<#BADDEV,#BDEVSZ,#40> ;Abort if bad dev
BCC 4$
IOT ;Punt if error
4$: JMP CLOOP ;Try again
UICPAR: CMPB (R1),#133 ;UIC? (="[")
BNE FILPAR ;Go parse filename, no UIC given
MOV R1,UICNAM ;Point to start of UIC
1$: INC UICCNT
CMPB (R1)+,#135 ;Scan to closing "]"
BNE 1$
SUB UICCNT,R4 ;Update count of characters left
FILPAR: MOV R1,FILNAM ;Point to start of filename
MOV R4,FILCNT ; & Store its length
CMPB COM,#123 ;See what we're supposed to do
BEQ RDFILE ;"S" - Go read in an old file
JMP WTFILE ;"G" - Go write out a new file
RDFILE: OPEN$R #FDB,#2,#DATSET,#FD.RWM,#DBUF,#512.,FILERR
QIOW$S #IO.WLB,#1,#1,,#WRSTS,,<#OKMES,#OKSIZ,#40> ;Tell 10 all's well
BCC 1$
IOT ;Punt if error
1$: MOV FDB+F.EFBK+2,R4 ;R4 has count of blocks in file
RLOOP: READ$ #FDB,,,,,,,RWERR ;Read in next block
WAIT$ #FDB,,,RWERR
TSTB IOSTAT ;Did it succeed?
BPL 1$ ; Yes
JMP RWERR ; No - punt
1$: DEC R4 ;One less block to read
BGT 2$ ;Was this the last block?
MOV F.FFBY(R0),FILDON ; Yes - tell 10 this is the end
2$: MOV #DBUF,BUFPTR ;Give buffer to 10
3$: ;?? ;Wait a bit
TST BUFPTR ;Has 10 finished with it yet?
BNE 3$ ; No - keep waiting
TST R4 ;More to send?
BGT RLOOP ; Yup - go read next block
JMP DONE ; No - go close file & get next command
WTFILE: OPEN$W #FDB,#2,#DATSET,#FD.RWM,#DBUF,#512.,FILERR
QIOW$S #IO.WLB,#1,#1,,#WRSTS,,<#OKMES,#OKSIZ,#40> ;Tell 10 all's well
BCC 1$
IOT ;Punt if error
1$: CLR R4 ;Keep a count of # of blocks we write
WLOOP: MOV #DBUF,BUFPTR ;Tell 10 where to stick block
1$: ;?? ;Wait a bit
TST BUFPTR ;Has 10 finished with it yet?
BNE 1$ ; No - keep waiting
WRITE$ #FDB,,,,,,,RWERR ;Write out next block
WAIT$ #FDB,,,RWERR
TSTB IOSTAT ;Did it succeed?
BMI RWERR ; No - punt
INC R4 ;Update block count
TST FILDON ;Was this last block?
BEQ WLOOP ; No - get next block
; Yes - fix up FDB
MOVB #2,F.RTYP+FDB ;Say we're really a variable length file
MOVB #2,F.RATT+FDB ;Say to print a cr after each record
MOV #130.,F.RSIZ+FDB ;Biggest record should be less than this
MOV R4,F.EFBK+2+FDB ;Tell how many blocks we are
MOV FILDON,F.FFBY+FDB ;Tell where the last record ends
;Now we can close the file
DONE: CLOSE$ #FDB,ERROR ;All done with file now
CLR BUFPTR
JMP CLOOP ;Get next command
FILERR: QIOW$S #IO.WLB,#1,#1,,#WRSTS,,<#BADFIL,#BFILSZ,#40> ;Abort if bad file
BCC 1$
IOT ;Punt if error
1$: JMP CLOOP ;Try again
RWERR: MOV #1,BUFPTR ;Abort if read/write error
JMP CLOOP ;Try again
ERROR: IOT ;Punt if error
;Auxiliary routine to print out the octal number in R1
OUTNUM: MOV R0,-(SP) ;We need some free registers
MOV R1,-(SP)
MOV R2,-(SP)
MOV R3,-(SP)
MOV #NUMBUF,R2 ;Where we'll stick the result
CLR R0
MOV #6,R3 ;6 digits to print
ASHC #1,R0 ;Get high order digit
1$: TST R0 ;Don't print leading zeros
BNE 2$ ;Found highest order non-zero digit
ASHC #3,R0 ;Try next
SOB R3,1$
INC R3
2$: ADD #60,R0 ;Convert to ASCII
MOVB R0,(R2)+ ;Stick it in buffer
CLR R0
ASHC #3,R0 ;Move on to next digit
SOB R3,2$ ;Do them all
SUB #NUMBUF,R2 ;Get character count for writing
QIOW$S #IO.WLB,#1,#1,,#WRSTS,,<#NUMBUF,R2,#40> ;Type it out
BCS ERROR ;Punt if error
MOV (SP)+,R3 ;Restore registers
MOV (SP)+,R2
MOV (SP)+,R1
MOV (SP)+,R0
RTS PC
.END START
.TITLE IMAGE MODE FTP ;IFTP.MAC
.MCALL ALUN$S,GLUN$S,QIOW$S,EXIT$S,GREG$S
.MCALL FDBDF$,FDAT$A,FDRC$A,FDBK$A,FDOP$A,FINIT$,FSRSZ$
.MCALL OPEN$W,CLOSE$,WRITE$,WAIT$
.BLKW 100 ;Make some stack space
SPSTRT:
REGBUF: .BLKW 3 ;To stick region info into
WRSTS: .WORD 0 ;Write status block
IOSTAT: .WORD 0,0 ;Status for disk ops
NUMBUF: .BLKB 12.
BUFPTR: .WORD 0
FILDON: .WORD 0
ALLDON: .WORD 1
FDB: FDBDF$ ;Make up the disk header info
FDAT$A R.FIX,,512.,-120. ; add write check
FDRC$A FD.RWM
FDBK$A BUFFER,512.,,2,IOSTAT
FDOP$A 2,DATSET
FSRSZ$ 0
BUFFER: .WORD 1,2,3,4,5,6
.BLKW 256. ;Disk block buffer
DATSET: .WORD 4,DEVNAM,9.,UIC,7,FILNAM
DEVNAM: .ASCII /DK3:/
UIC: .ASCII /[200,200]/
FILNAM: .ASCII /A.FTP;1/
.EVEN
START: MOV #SPSTRT,SP ;Set up stack???
ALUN$S #1,#"TI,#0 ;LUN 1 is TI: device
BCC 1$
IOT ;Punt if error
1$: QIOW$S #IO.ATT,#1,#1 ;Attach it
BCC 2$
IOT ;Punt if error
2$: GREG$S ,#REGBUF ;Get region base address
BCC 3$
IOT
3$: MOV REGBUF,R1
JSR PC,OUTNUM ;Print it out
MOV #BUFPTR,R1 ;Give local address of buffer pointer
JSR PC,OUTNUM ;Print it out
ALUN$S #2,#"DK,#3 ;LUN 2 is DK3:
BCC 4$
IOT ;Punt if error
4$: FINIT$
BCC FLOOP
IOT
FLOOP: TST ALLDON ;Is 10 still there?
BNE 1$ ; Yes
JMP BYE ; No
1$: TST FILDON ;Ready to write another file?
BEQ FLOOP ; No - keep waiting
OPEN$W #FDB,,,,,,ERROR ;Open up the file
WLOOP: MOV #BUFFER,BUFPTR ;Tell 10 where to put data
1$: TST FILDON ;See if 10 has more to write
BEQ DONE ; No - all done with this file
TST BUFPTR ; Yes - wait for it to fill buffer
BNE 1$
WRITE$ #FDB,,,,,,,ERROR ;Write out the buffer
WAIT$ #FDB,,,ERROR ;Wait til it's written
TSTB IOSTAT ;Did it get written out ok?
BPL 2$
IOT
2$: JMP WLOOP ;Go wait for the next block to write
DONE: CLOSE$ #FDB,ERROR ;All done with file now
CLR BUFPTR
INCB FILNAM ;Use new file name for next
JMP FLOOP ;See if more to do
BYE: EXIT$S ERROR ;Go away
ERROR: IOT ;Crash if any errors
;Auxiliary routine to print out the octal number in R1
OUTNUM: MOV R0,-(SP) ;We need some free registers
MOV R1,-(SP)
MOV R2,-(SP)
MOV R3,-(SP)
MOV #NUMBUF,R2 ;Where we'll stick the result
CLR R0
MOV #6,R3 ;6 digits to print
ASHC #1,R0 ;Get high order digit
1$: TST R0 ;Don't print leading zeros
BNE 2$ ;Found highest order non-zero digit
ASHC #3,R0 ;Try next
SOB R3,1$
INC R3
2$: ADD #60,R0 ;Convert to ASCII
MOVB R0,(R2)+ ;Stick it in buffer
CLR R0
ASHC #3,R0 ;Move on to next digit
SOB R3,2$ ;Do them all
SUB #NUMBUF,R2 ;Get character count for writing
QIOW$S #IO.WLB,#1,#1,,#WRSTS,,<#NUMBUF,R2,#40> ;Type it out
BCS ERROR ;Punt if error
MOV (SP)+,R3 ;Restore registers
MOV (SP)+,R2
MOV (SP)+,R1
MOV (SP)+,R0
RTS PC
.END START
.TITLE DISK I/O TEST PROGRAM ;DISKB.MAC
.MCALL ALUN$S,GLUN$S,QIOW$S,EXIT$S,GREG$S
.MCALL FDBDF$,FDAT$A,FDRC$A,FDBF$A,FDOP$A,FINIT$,FSRSZ$,OPEN$R,CLOSE$,GET$
.BLKW 100 ;Make some stack space
SPSTRT:
IOSTAT: .WORD 0,0 ;Status for disk ops
RDSTS: .WORD 0 ;Read status block
RDCNT: .WORD 0
WRSTS: .WORD 0 ;Write status block
.BLKW 3 ;Filler
FDB: FDBDF$ ;Make up the disk header info
; FDAT$A R.VAR,FD.CR
; FDRC$A ,RBUF,130.
; FDOP$A 2,DATSET,,FO.RD
FDBF$A
FSRSZ$ 1
RBUF: .BLKB 512.
DATSET: .WORD 4,DEVNAM,9.,UIC,6,FILNAM
DEVNAM: .ASCII /DK0:/
UIC: .ASCII /[200,200]/
FILNAM: .ASCII /FOO.;1/
BUFFER: .BLKB 82.
HIMES: .ASCII /DISK RECORD PRINT PROGRAM/
HISIZE = .-HIMES
BYEMES: .ASCII /THAT'S IT/
BYESIZ = .-BYEMES
.EVEN
START: MOV #SPSTRT,SP ;Set up stack???
ALUN$S #1,#"TI,#0 ;LUN 1 is TI: device
BCC 1$
JMP ERROR ;Punt if error
1$: QIOW$S #IO.ATT,#1,#1 ;Attach it
BCC 2$
JMP ERROR ;Punt if error
2$: ALUN$S #2,#"DK,#0 ;LUN 2 is DK0:
BCC 3$
JMP ERROR ;Punt if error
3$: QIOW$S #IO.WLB,#1,#1,,#WRSTS,,<#HIMES,#HISIZE,#40> ;Say Hello
BCC 4$
JMP ERROR ;Punt if error
4$: FINIT$
BCC 5$
JMP ERROR
5$: OPEN$R #FDB,#2,#DATSET,,#RBUF,#512.,ERROR
MOV #BUFFER,R2
MOV #RBUF,R1 ;Get buffer address
JSR PC,OUTNUM
MOVB #40,(R2)+ ;Append two spaces
MOVB #40,(R2)+
MOV F.FFBY+FDB,R1 ;Tell where the last record ends
JSR PC,OUTNUM
SUB #BUFFER,R2
QIOW$S #IO.WLB,#1,#1,,#WRSTS,,<#BUFFER,R2,#40> ;Type it out
BCC 10$
JMP ERROR ;Punt if error
10$: GET$ #FDB,,,CKEOF ;Read in the next record
MOV #BUFFER,R2
MOV F.NRBD(R0),R1 ;Get number of bytes read
JSR PC,OUTNUM ;Print out record attribute bits
MOVB #40,(R2)+ ;Append two spaces
MOVB #40,(R2)+
MOV F.NRBD+2(R0),R1 ;Get address of buffer
JSR PC,OUTNUM ;Print out record attribute bits
SUB #BUFFER,R2
QIOW$S #IO.WLB,#1,#1,,#WRSTS,,<#BUFFER,R2,#40> ;Type it out
BCS ERROR ;Punt if error
MOV F.NRBD(R0),R2 ;Get number of bytes read
MOV F.NRBD+2(R0),R1 ;Get address of buffer
QIOW$S #IO.WLB,#1,#1,,#WRSTS,,<R1,R2,#40> ;Type it out
BCS ERROR ;Punt if error
BR 10$
CKEOF: CMPB #IE.EOF,F.ERR(R0) ;Check if end of file
BNE RDERR ;Punt if not
CLOSE$ R0 ;All done with file now
BCS ERROR ;Punt if error
QIOW$S #IO.WLB,#1,#1,,#WRSTS,,<#BYEMES,#BYESIZ,#60> ;Say good bye
BCS ERROR ;Punt if error
EXIT$S ERROR ;Go away
JMP START ;?????
RDERR: MOV #BUFFER,R2
MOVB #105,(R2)+ ;"E "
MOVB #40,(R2)+
MOVB F.ERR(R0),R1 ;Get error condition number
JSR PC,OUTNUM
MOVB #40,(R2)+
MOVB #40,(R2)+
MOVB F.ERR+1(R0),R1 ;Get error number
SUB #BUFFER,R2
QIOW$S #IO.WLB,#1,#1,,#WRSTS,,<#BUFFER,R2,#40> ;Type it out
ERROR: MOV #BUFFER,R2
MOVB #104,(R2)+ ;"D "
MOVB #40,(R2)+
MOV $DSW,R1 ;Get Directive Status Word too
JSR PC,OUTNUM
SUB #BUFFER,R2
QIOW$S #IO.WLB,#1,#1,,#WRSTS,,<#BUFFER,R2,#40> ;Type it out
IOT ;Crash if any errors
;Auxiliary routine to add the octal number in R1 to the buffer R2 points at
OUTNUM: MOV R0,-(SP) ;We need some free registers
MOV R1,-(SP)
MOV R3,-(SP)
CLR R0
MOV #6,R3 ;6 digits to print
ASHC #1,R0 ;Get high order digit
1$: TST R0 ;Don't print leading zeros
BNE 2$ ;Found highest order non-zero digit
ASHC #3,R0 ;Try next
SOB R3,1$
INC R3
2$: ADD #60,R0 ;Convert to ASCII
MOVB R0,(R2)+ ;Stick it in buffer
CLR R0
ASHC #3,R0 ;Move on to next digit
SOB R3,2$ ;Do them all
MOV (SP)+,R3 ;Restore registers
MOV (SP)+,R1
MOV (SP)+,R0
RTS PC
.END START
.TITLE DISK I/O TEST PROGRAM ;DISKI.MAC
.MCALL ALUN$S,GLUN$S,QIOW$S,EXIT$S,GREG$S
.MCALL FDBDF$,FDAT$A,FDRC$A,FDBK$A,FDOP$A,FINIT$,FSRSZ$,OPEN$R,CLOSE$,READ$
.BLKW 100 ;Make some stack space
SPSTRT:
IOSTAT: .WORD 0,0 ;Status for disk ops
RDSTS: .WORD 0 ;Read status block
RDCNT: .WORD 0
WRSTS: .WORD 0 ;Write status block
FDB: FDBDF$ ;Make up the disk header info
FDAT$A R.FIX,,512.
FDRC$A FD.RWM
FDBK$A DBUF,512.,,2,IOSTAT
FDOP$A 2,DATSET,,FO.RD
FSRSZ$ 0
DBUF: .BLKW 512.
DATSET: .WORD 4,DEVNAM,9.,UIC,6,FILNAM
DEVNAM: .ASCII /DK0:/
UIC: .ASCII /[200,200]/
FILNAM: .ASCII /FOO.;1/
BUFFER: .BLKB 82.
HIMES: .ASCII /DISK IMAGE PRINT PROGRAM/
HISIZE = .-HIMES
INIMES: .ASCII /FINIT DONE/
INISIZ = .-INIMES
OPNMES: .ASCII /OPEN DONE/
OPNSIZ = .-OPNMES
RDBMES: .ASCII /READ DONE/
RDBSIZ = .-RDBMES
BYEMES: .ASCII /THAT'S IT/
BYESIZ = .-BYEMES
.EVEN
START: MOV #SPSTRT,SP ;Set up stack???
ALUN$S #1,#"TI,#0 ;LUN 1 is TI: device
BCC 1$
JMP ERROR ;Punt if error
1$: QIOW$S #IO.ATT,#1,#1 ;Attach it
BCC 2$
JMP ERROR ;Punt if error
2$: ALUN$S #2,#"DK,#0 ;LUN 2 is DK0:
BCC 3$
JMP ERROR ;Punt if error
3$: QIOW$S #IO.WLB,#1,#1,,#WRSTS,,<#HIMES,#HISIZE,#40> ;Say Hello
BCC 4$
JMP ERROR ;Punt if error
4$: FINIT$
BCC 5$
JMP ERROR
5$: QIOW$S #IO.WLB,#1,#1,,#WRSTS,,<#INIMES,#INISIZ,#40> ;Report progress
OPEN$R #FDB,,,#FD.RWM,,,ERROR
BCC 6$
JMP ERROR
6$: QIOW$S #IO.WLB,#1,#1,,#WRSTS,,<#OPNMES,#OPNSIZ,#40> ;Report progress
READ$ #FDB,,,,,,,ERROR
BCC 7$
JMP ERROR
7$: QIOW$S #IO.WLB,#1,#1,,#WRSTS,,<#RDBMES,#RDBSIZ,#40> ;Report progress
MOV #0,R0 ;Byte count of where we are in buffer
MOV #DBUF,R3
10$: MOV #BUFFER,R2
MOV R0,R1 ;Show buffer address
JSR PC,OUTNUM
MOVB #72,(R2)+ ;Append ": "
MOVB #40,(R2)+
MOV (R3),R1 ;Get next word
JSR PC,OUTNUM
MOVB #75,(R2)+ ;Append "= "
MOVB #40,(R2)+
MOVB (R3)+,R1 ;Show first byte
BIC #177400,R1
JSR PC,OUTNUM
MOVB #40,(R2)+ ;Append two spaces
MOVB #40,(R2)+
MOVB (R3)+,R1 ;Show second byte
BIC #177400,R1
JSR PC,OUTNUM
SUB #BUFFER,R2 ;Get character count for writing
QIOW$S #IO.WLB,#1,#1,,#WRSTS,,<#BUFFER,R2,#40> ;Type it out
BCS ERROR ;Punt if error
ADD #2,R0
CMP R0,#256. ;Only look at the first N words
BLT 10$
QIOW$S #IO.WLB,#1,#1,,#WRSTS,,<#BYEMES,#BYESIZ,#60> ;Say good bye
BCS ERROR ;Punt if error
EXIT$S ERROR ;Go away
JMP START ;?????
ERROR: IOT ;Crash if any errors
;Auxiliary routine to add the octal number in R1 to the buffer R2 points at
OUTNUM: MOV R0,-(SP) ;We need some free registers
MOV R1,-(SP)
MOV R3,-(SP)
CLR R0
MOV #6,R3 ;6 digits to print
ASHC #1,R0 ;Get high order digit
1$: TST R0 ;Don't print leading zeros
BNE 2$ ;Found highest order non-zero digit
ASHC #3,R0 ;Try next
SOB R3,1$
INC R3
2$: ADD #60,R0 ;Convert to ASCII
MOVB R0,(R2)+ ;Stick it in buffer
CLR R0
ASHC #3,R0 ;Move on to next digit
SOB R3,2$ ;Do them all
MOV (SP)+,R3 ;Restore registers
MOV (SP)+,R1
MOV (SP)+,R0
RTS PC
.END START